home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / PTEXT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  2.4 KB  |  101 lines
  1. { ptext.pas -- Edit and print a text file }
  2.  
  3. program PText;
  4.  
  5. uses WinTypes, WinProcs, WObjects, Strings, StdWnds, UPrint;
  6.  
  7. const
  8.  
  9.   id_Menu = 'FileCommands';    { Menu resource ID }
  10.   cm_FilePrint = 100;          { ID for new File:Print command }
  11.   bufSize = 80;                { Maximum characters per line }
  12.  
  13. type
  14.  
  15.   PTextApplication = object(TApplication)
  16.     procedure InitMainWindow; virtual;
  17.     procedure InitInstance; virtual;
  18.   end;
  19.  
  20.   PPTextWindow = ^PTextWindow;
  21.   PTextWindow = object(TFileWindow)
  22.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  23.     procedure CMPrint(var Msg: TMessage);
  24.       virtual cm_First + cm_FilePrint;
  25.   end;
  26.  
  27.  
  28. { PTextApplication }
  29.  
  30. {- Initialize PTextApplication object's window }
  31. procedure PTextApplication.InitMainWindow;
  32. begin
  33.   MainWindow := New(PPTextWindow, Init(nil, 'Edit and Print Text'))
  34. end;
  35.  
  36. {- Initialize each application instance }
  37. procedure PTextApplication.InitInstance;
  38. begin
  39.   TApplication.InitInstance;
  40.   if Status = 0 then
  41.     HAccTable := LoadAccelerators(HInstance, 'FileCommands')
  42. end;
  43.  
  44.  
  45. { PTextWindow }
  46.  
  47. {- Construct PTextWindow object }
  48. constructor PTextWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  49. var
  50.   Mh: HMenu;
  51. begin
  52.   TFileWindow.Init(AParent, ATitle, nil);
  53.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  54.   Mh := GetSubMenu(Attr.Menu, 0);
  55.   if Mh <> 0 then
  56.     InsertMenu(Mh, 4, mf_ByPosition or mf_Enabled,
  57.       cm_FilePrint, '&Print')
  58. end;
  59.  
  60. {- Print text in editor window }
  61. procedure PTextWindow.CMPrint(var Msg: TMessage);
  62. var
  63.   NumLines, LineIndex, Len: Integer;
  64.   Buffer: PChar;
  65. begin
  66.   LineIndex := 0;
  67.   NumLines := Editor^.GetNumLines;
  68.   if (NumLines > 0) and PrnStart('PText') then
  69.   begin
  70.     while LineIndex < NumLines do
  71.     begin
  72.       Len := Editor^.GetLineLength(LineIndex) + 1;
  73.       GetMem(Buffer, Len);
  74.       if Len > 1 then
  75.         Editor^.GetLine(Buffer, Len, LineIndex)
  76.       else
  77.         Buffer^ := #0;
  78.       PrnLine(Buffer);
  79.       Inc(LineIndex);
  80.       FreeMem(Buffer, Len)
  81.     end;
  82.     PrnStop
  83.   end
  84. end;
  85.  
  86. var
  87.  
  88.   PTextApp: PTextApplication;
  89.  
  90. begin
  91.   PTextApp.Init('PTextApp');
  92.   PTextApp.Run;
  93.   PTextApp.Done
  94. end.
  95.  
  96.  
  97. {--------------------------------------------------------------
  98.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  99.   Revision 1.00    Date: 5/16/1991
  100. ---------------------------------------------------------------}
  101.